home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / backup.arc / BKP102.RPG < prev    next >
Encoding:
Text File  |  1991-12-04  |  15.0 KB  |  188 lines
  1. ~    H*  *  CRTRPGPGM   PGM(BKP102.YOURLIB) SRCFILE(YOUSRC.YOURLIB) +           
  2. ~    H*                   USRPRF(*USER) PUBAUT(*NORMAL)            *            
  3. ~    H*                                                                         
  4. ~    H*  ***********************************************************            
  5. ~    H*  * PROGRAM:  BKP102.YOURLIB                                *            
  6. ~    H*  * DISCRIPTION: EXECUTE BACKUP COMMANDS                    *            
  7. ~    H*  *                                                         *            
  8. ~    H*  *                                                         *            
  9. ~    H*  * COMPILATION OPTIONS: NONE                               *            
  10. ~    H*  * SWITCHES: NONE                                          *            
  11. ~    H*  *                                                         *            
  12. ~    H*  * WRITEN BY BRIAN GREWAL.                                 *            
  13. ~    H*  *                                                         *            
  14. ~    H*  * DITO DITTO DITTTO                                       *            
  15. ~    H*  *                                                         *            
  16. ~    H*  *                                                         *            
  17. ~    H*  *                                                         *            
  18. ~    H*  *                                                         *            
  19. ~    H*  ***********************************************************            
  20.      H*                                                                         
  21.      FBACKUPF IF  E           K        DISK                                     
  22.      E                    PM      1   2 52                PARM MESSAGE          
  23.      E                    OBJ        50 11                                      
  24.      E                    LIB        50 11                                      
  25.      C           *ENTRY    PLIST                           ~                    
  26.      C                     PARM           WBKPTP  7        ~BACKUP TYPE         
  27.      C                     PARM           DEVICE  1        ~SAVE DEVICE         
  28. ~    C* DEFINE KEY                                                              
  29. ~    C*                                                                         
  30.      C           KEY       KLIST                           ~                    
  31.      C                     KFLD           WORK             ~                    
  32.      C                     KFLD           WSAVCD           ~                    
  33.      C                     KFLD           WORKLI 10        ~                    
  34.      C                     KFLD           WORKOB 10        ~                    
  35. ~    C**                                                                        
  36. ~    C* BACKUP TYPE VALID CODES ARE :-                                          
  37. ~    C*       DAILY   - FOR DAILY BACKUP                                        
  38. ~    C*       WEEKLY  - FOR WEEKLY BACKUP                                       
  39. ~    C*       MONTHLY - FOR MONTHLY BACKUP                                      
  40. ~    C*       SPECIAL - FOR SPECIAL BACKUPS                                     
  41. ~    C**                                                                        
  42.      C           WBKPTP    IFNE 'DAILY  '                  ~                    
  43.      C           WBKPTP    ANDNE'WEEKLY '                  ~                    
  44.      C           WBKPTP    ANDNE'MONTHLY'                  ~                    
  45.      C           WBKPTP    ANDNE'SPECIAL'                  ~                    
  46.      C                     MOVELWBKPTP    PM,1             ~                    
  47.      C           PM,1      DSPLY                           ~                    
  48.      C                     GOTO EXIT                       ~                    
  49.      C                     END                             ~                    
  50. ~    C**                                                                        
  51. ~    C* DEVICE TYPE VALID CODES ARE :-                                          
  52. ~    C*            D  - DISKETTE DRIVE                                          
  53. ~    C*            T  - TAPE DRIVE                                              
  54. ~    C*            S  - SAVE FILES                                              
  55. ~    C**                                                                        
  56.      C           DEVICE    IFNE 'D'                        ~                    
  57.      C           DEVICE    ANDNE'T'                        ~                    
  58.      C           DEVICE    ANDNE'S'                        ~                    
  59.      C                     MOVELDEVICE    PM,2             ~                    
  60.      C           PM,2      DSPLY                           ~                    
  61.      C                     GOTO EXIT                       ~                    
  62.      C                     END                             ~                    
  63. ~    C**                                                                        
  64. ~    C* PARMS PASSED WERE VALID SO START PROCESSING                             
  65. ~    C**                                                                        
  66. ~    C** SET ON/ OFF INDICATORS                                                 
  67.      C                     MOVE '1'       ON      1        ~                    
  68.      C                     MOVE '0'       OFF     1        ~                    
  69. ~    C*                                                                         
  70.      C                     MOVEL'*ALL'    DEFALT 10        ~                    
  71. ~    C* PROCESS SAVELIB COMMANDS                                                
  72.      C                     MOVELWBKPTP    WORK    1        ~                    
  73.      C                     MOVE 'A'       WSAVCD  1        ~                    
  74.      C           KEY       SETLLBACKUPF                    ~                    
  75.      C                     Z-ADD0         X       20       ~                    
  76.      C                     MOVE *BLANKS   LIB              ~                    
  77.      C                     MOVE *BLANKS   OBJ              ~                    
  78. ~    C**                                                                        
  79. ~    C* RETURN HERE FOR NEXT SET OF "A" SAVE CODES                              
  80. ~    C**                                                                        
  81.      C           NEXTSA    TAG                             ~                    
  82.      C           X         DOWLE49                         ~                    
  83.      C                     READ BACKUPF                  50~                    
  84.      C           *IN50     IFEQ OFF                        ~                    
  85.      C           WORK      ANDEQBKPTYP                     ~                    
  86.      C           SAVCOD    ANDEQ'A'                        ~                    
  87.      C                     ADD  1         X                ~                    
  88.      C                     MOVELLIBNAM    LIB,X            ~                    
  89.      C                     ELSE                            ~                    
  90.      C                     GOTO SKIPA                      ~                    
  91.      C                     END                             ~*IN50 IFEQ OFF      
  92.      C  N50                END                             ~X DOWLE 49          
  93.      C           SKIPA     TAG                             ~                    
  94. ~    C**                                                                        
  95. ~    C* DEFAULT OBJ,1 WITH "*ALL"                                               
  96. ~    C**                                                                        
  97.      C           X         IFGE 1                          ~                    
  98.      C                     MOVELDEFALT    OBJ,1            ~                    
  99.      C                     MOVE *BLANKS   RTNCOD  8        ~                    
  100.      C                     CALL 'BACKUP'                   ~                    
  101.      C                     PARM           WBKPTP           ~                    
  102.      C                     PARM           DEVICE           ~                    
  103.      C                     PARM           OBJ              ~                    
  104.      C                     PARM           LIB              ~                    
  105.      C                     PARM           WSAVCD           ~                    
  106.      C                     PARM           RTNCOD           ~                    
  107.      C           RTNCOD    CABEQ'ABORT   'EXIT             ~                    
  108.      C                     END                             ~X IFGE 1            
  109. ~    C**                                                                        
  110. ~    C* IF 50 OBJECTS READ AND MORE LEFT GOTO READ AGAIN                        
  111. ~    C**                                                                        
  112.      C           BKPTYP    IFEQ WORK                       ~                    
  113.      C           *IN50     ANDEQOFF                        ~                    
  114.      C           SAVCOD    ANDEQ'A'                        ~                    
  115.      C                     MOVE *BLANKS   LIB              ~                    
  116.      C                     MOVE *BLANKS   OBJ              ~                    
  117.      C                     Z-ADD1         X                ~                    
  118.      C                     MOVELLIBNAM    LIB,X            ~                    
  119.      C                     GOTO NEXTSA                     ~                    
  120.      C                     END                             ~BKPTYP EQ WBKP      
  121. ~    C**                                                                        
  122. ~    C* IF BKPTYP CHANGED OR EOF REACHED EXIT                                   
  123. ~    C**                                                                        
  124.      C           WORK      CABNEBKPTYP    EXIT             ~                    
  125.      C           *IN50     CABEQON        EXIT             ~                    
  126. ~    C**                                                                        
  127. ~    C* IF FINISHED "A" SAVE CODES PROCESS "S" SAVE CODES                       
  128. ~    C**                                                                        
  129.      C                     MOVE 'S'       WSAVCD           ~                    
  130.      C           KEY       SETLLBACKUPF                    ~                    
  131.      C                     Z-ADD0         X       20       ~                    
  132.      C                     MOVE *BLANKS   OBJ              ~                    
  133.      C                     MOVE *BLANKS   LIB              ~                    
  134. ~    C**                                                                        
  135. ~    C* RETURN HERE FOR NEXT SET OF "S" SAVE CODES                              
  136. ~    C**                                                                        
  137.      C           NEXTSS    TAG                             ~                    
  138.      C           X         DOWLE49                         ~                    
  139.      C                     READ BACKUPF                  50~                    
  140.      C           *IN10     IFEQ OFF                        ~                    
  141.      C                     MOVE LIBNAM    WLIBNM 10        ~                    
  142.      C                     SETON                     10    ~                    
  143.      C                     END                             ~*IN10 EQ OFF        
  144.      C           *IN50     IFEQ OFF                        ~                    
  145.      C           WORK      ANDEQBKPTYP                     ~                    
  146.      C           SAVCOD    ANDEQ'S'                        ~                    
  147.      C           LIBNAM    ANDEQWLIBNM                     ~                    
  148.      C                     ADD  1         X                ~                    
  149.      C                     MOVELOBJNAM    OBJ,X            ~                    
  150.      C                     ELSE                            ~                    
  151.      C                     GOTO SKIPS                      ~                    
  152.      C                     END                             ~*IN50 IFEQ OFF      
  153.      C  N50                END                             ~X DOWLE 49          
  154.      C           SKIPS     TAG                             ~                    
  155.      C           X         IFGE 1                          ~                    
  156.      C                     MOVELWLIBNM    LIB,1            ~                    
  157.      C                     MOVE *BLANKS   RTNCOD  8        ~                    
  158.      C                     CALL 'BACKUP'                   ~                    
  159.      C                     PARM           WBKPTP           ~                    
  160.      C                     PARM           DEVICE           ~                    
  161.      C                     PARM           OBJ              ~                    
  162.      C                     PARM           LIB              ~                    
  163.      C                     PARM           WSAVCD           ~                    
  164.      C                     PARM           RTNCOD           ~                    
  165.      C           RTNCOD    CABEQ'ABORT   'EXIT             ~                    
  166.      C                     MOVE LIBNAM    WLIBNM           ~                    
  167.      C                     END                             ~X IFGE 1            
  168. ~    C**                                                                        
  169. ~    C* IF 50 OBJECTS READ AND MORE LEFT GOTO READ AGAIN                        
  170. ~    C**                                                                        
  171.      C           BKPTYP    IFEQ WORK                       ~                    
  172.      C           *IN50     ANDEQOFF                        ~                    
  173.      C           SAVCOD    ANDEQ'S'                        ~                    
  174.      C                     MOVE *BLANKS   OBJ              ~                    
  175.      C                     MOVE *BLANKS   LIB              ~                    
  176.      C                     Z-ADD1         X                ~                    
  177.      C                     MOVELOBJNAM    OBJ,X            ~                    
  178.      C                     GOTO NEXTSS                     ~                    
  179.      C                     END                             ~BKPTYP EQ WBKP      
  180. ~    C**                                                                        
  181. ~    C* EXIT POINT                                                              
  182. ~    C**                                                                        
  183.      C           EXIT      TAG                             ~                    
  184.      C                     SETON                     LR    ~                    
  185. ** INVALID PARMS PASSED                                                         
  186.          is Invalid backup type. BACKUP CANCELED                                
  187.   is Invalid device type. BACKUP Command CANCELED                               
  188.